home *** CD-ROM | disk | FTP | other *** search
/ Belgian Amiga Club - ADF Collection / BS1 part 41.zip / BS1 part 41 / Coder v1.2.2.adf / code / chiffre.mod < prev    next >
Text File  |  2000-01-02  |  2KB  |  90 lines
  1. IMPLEMENTATION MODULE Chiffre;
  2.  
  3. FROM SYSTEM IMPORT SHIFT,LONGSET;
  4. FROM RndNum IMPORT PutSeed,GetSeed,RND;
  5.  
  6. TYPE multi=RECORD
  7.        CASE :BOOLEAN OF
  8.          TRUE:  i:LONGCARD |
  9.          FALSE: s:LONGSET
  10.        END
  11.      END;
  12.  
  13. VAR seed1,seed2,seed3,seed4:LONGCARD;
  14.  
  15. PROCEDURE Xor(a,b:LONGCARD):LONGCARD;
  16. VAR a1,b1:multi;
  17.     i:INTEGER;
  18. BEGIN
  19.   a1.i:=a; b1.i:=b;
  20.   FOR i:=0 TO 31 DO
  21.     IF ((i IN a1.s)=(i IN b1.s)) & (i IN a1.s) THEN EXCL(a1.s,i) END
  22.   END;
  23.   RETURN a1.i
  24. END Xor;
  25.  
  26. PROCEDURE CPrep(VAR key:ARRAY OF CHAR);
  27. VAR st,x0:LONGCARD;
  28.     i:CARDINAL;
  29. BEGIN
  30.   st:=0; i:=0; x0:=0;
  31.   WHILE (i<=CARDINAL(HIGH(key))) & (key[i]#CHR(0)) DO
  32.     x0:=Xor(x0,ORD(key[i]));
  33.     IF (key[i]>="A") & (key[i]<="Z") THEN
  34.       st:=st+LONGCARD(ORD(key[i])-ORD("A")+1)*(i*55+1)
  35.     ELSIF (key[i]>="a") & (key[i]<="z") THEN
  36.       st:=st+LONGCARD(ORD(key[i])-ORD("a")+27)*(i*55+1)
  37.     ELSE
  38.       key[i]:=" "; st:=st+54
  39.     END;
  40.     i:=i+1
  41.   END;
  42.   st:=st+i*333H;
  43.   seed1:=st; seed2:=SHIFT(x0,18); seed3:=Xor(seed1,seed2); seed4:=seed1+seed2
  44. END CPrep;
  45.  
  46. PROCEDURE Fac():INTEGER;
  47. VAR a:INTEGER;
  48.  
  49.   PROCEDURE ThisFac(VAR seed:LONGCARD; n:INTEGER):INTEGER;
  50.   VAR x:INTEGER;
  51.   BEGIN
  52.     PutSeed(seed); x:=RND(n); GetSeed(seed);
  53.     RETURN x
  54.   END ThisFac;
  55.  
  56. BEGIN
  57.   a:=ThisFac(seed1,110)+ThisFac(seed2,44+ThisFac(seed3,55)+ThisFac(seed4,25));
  58.   IF (Xor(seed1,Xor(seed2,Xor(seed3,seed4))) MOD 2)=1 THEN a:=-a END;
  59.   RETURN a
  60. END Fac;
  61.  
  62. PROCEDURE CTrans(d:BOOLEAN; VAR c:CHAR);
  63. VAR a:INTEGER;
  64. BEGIN
  65.   IF d THEN
  66.     a:=ORD(c)+Fac()
  67.   ELSE
  68.     a:=ORD(c)-Fac()
  69.   END;
  70.   IF a<0 THEN a:=a+100H ELSIF a>0FFH THEN a:=a-100H END;
  71.   c:=CHR(a)
  72. END CTrans;
  73.  
  74. PROCEDURE CCode(d:BOOLEAN; VAR txt:ARRAY OF CHAR; tlen:LONGCARD);
  75. VAR i:LONGCARD;
  76.     a:INTEGER;
  77. BEGIN
  78.   FOR i:=0 TO tlen-1 DO
  79.     IF d THEN
  80.       a:=ORD(txt[i])+Fac()
  81.     ELSE
  82.       a:=ORD(txt[i])-Fac()
  83.     END;
  84.     IF a<0 THEN a:=a+100H ELSIF a>0FFH THEN a:=a-100H END;
  85.     txt[i]:=CHR(a)
  86.   END
  87. END CCode;
  88.  
  89. END Chiffre.
  90.